home *** CD-ROM | disk | FTP | other *** search
/ PC-SIG: World of Games / PC-SIG World of Games (CDRM1080710) (1993).iso / 2089 / SG.BAS < prev    next >
BASIC Source File  |  1991-01-16  |  61KB  |  1,798 lines
  1. DECLARE SUB NukeCursor ()
  2. DECLARE SUB WaitForKey ()
  3. DECLARE SUB WaitOne ()
  4. DECLARE SUB MagicInput (InRow%, InCol%, InLen%, InDef$, in$)
  5. DECLARE SUB TitlePage ()
  6. DECLARE SUB PickOrigin (OrgRow%, OrgCol%)
  7. DECLARE SUB PickDestination (DestRow%, DestCol%)
  8. DECLARE SUB cursor ()
  9. DECLARE SUB DrawBoard ()
  10. DECLARE SUB DrawBorder ()
  11. DECLARE SUB SetColor ()
  12. DECLARE SUB SetMono ()
  13. DECLARE SUB PrintInst (inst$, InColor%)
  14. DECLARE SUB Quit ()
  15. DECLARE SUB PrintScore ()
  16. DECLARE SUB PrintMoves ()
  17. DECLARE SUB Help ()
  18. DECLARE SUB PrintPane (r%, c%)
  19. DECLARE SUB StartOver ()
  20. DECLARE SUB CheckMove ()
  21. DECLARE SUB Move ()
  22. DECLARE SUB Win ()
  23. DECLARE SUB ClearBoard ()
  24. DECLARE SUB RedrawBoard ()
  25. DECLARE SUB Load ()
  26. DECLARE SUB save ()
  27. DECLARE SUB Rules ()
  28. DECLARE SUB Panic ()
  29. DECLARE SUB PrintHelp ()
  30. DECLARE SUB FigureScore ()
  31. DECLARE SUB CheckStuck ()
  32. DECLARE SUB Lose ()
  33. DECLARE SUB HotKeyRecovery (hot$)
  34. DECLARE SUB Hint ()
  35. DECLARE SUB NukeHelp ()
  36. DECLARE SUB BackUp ()
  37. DECLARE SUB PrintBackups ()
  38. DECLARE SUB DestCursor ()
  39. DECLARE SUB BackUpAllTheWay ()
  40. DECLARE SUB LicenseInfo ()
  41. DECLARE SUB UntagSource ()
  42.  
  43. ' the following are all the many variables that I'm too lazy to pass back and
  44. ' forth between subprograms like a good little C-weenie
  45.  
  46. DIM SHARED InColor%
  47. DIM SHARED ColorVal%(7), inst$, remainder%, ColorName$(7), in$
  48. DIM SHARED m%(6, 12), t%(6, 12), Row%, Col%, RowMod%(8), ColMod%(8), Control$, MoveCounter%
  49. DIM SHARED primary%, Secondary%, Tertiary%, StartOverFlag%
  50. DIM SHARED OrgRow%, OrgCol%, OrgColor%, OrgClass%, OldInst$
  51. DIM SHARED JumpRow%, JumpCol%, JumpColor%, JumpClass%, JumpValue%
  52. DIM SHARED DestRow%, DestCol%, DestColor%, DestClass%
  53. DIM SHARED BadFlag%, TitleMove%(16, 4)
  54. DIM SHARED ColorFlag%, LastFileName$
  55. DIM SHARED game%(108, 9)
  56. DIM SHARED BackupCount%, MemFlag%, AbortMoveFlag%, DestFlag%
  57. DIM SHARED GoodMove%(8, 2), prog$
  58. DIM SHARED pane$(7, 3), class%(7)
  59. DIM SHARED JumpTable%(7, 7), DestTable%(7, 7)
  60.  
  61. GOSUB init             ' initialize unchanging variables
  62. CALL TitlePage         ' do the demo loop until user wants to play
  63.  
  64. start:
  65. prog$ = "Main"         ' used in error trapping
  66. CALL PrintHelp         ' print the menu sidebar on the right side of the screen
  67. CALL DrawBoard         ' randomize and draw the board
  68. Row% = 1               ' set cursor row and column to 1 at beginning
  69. Col% = 1
  70.  
  71. Main:
  72.  CALL PickOrigin(OrgRow%, OrgCol%)      ' get the source pane
  73.   IF StartOverFlag% = 1 THEN            ' if user wants to restart, do it
  74.     StartOverFlag% = 0
  75.     GOTO start
  76.   END IF
  77.  CALL PickDestination(DestRow%, DestCol%) ' get the destination pane
  78.   IF AbortMoveFlag% = 1 THEN              ' if user wants to move a different
  79.     AbortMoveFlag% = 0                    ' pane, do it
  80.     CALL UntagSource
  81.     GOTO Main
  82.   END IF
  83.   IF StartOverFlag% = 1 THEN              ' if user wants to restart, do it
  84.     StartOverFlag% = 0
  85.     GOTO start
  86.   END IF
  87.  CALL CheckMove                           ' check that it's a legal move
  88.  CALL Move                                ' do the move
  89.   IF remainder% = 1 THEN                  ' if user is down to one pane,
  90.    CALL Win                               ' declare a win
  91.    GOTO start
  92.   END IF
  93.  CALL CheckStuck                          ' check for stuckness
  94.   IF StartOverFlag% = 1 THEN              ' if user wants to restart, do it
  95.     StartOverFlag% = 0
  96.     GOTO start
  97.   END IF
  98. GOTO Main
  99.  
  100. init:
  101.  CLS                                      ' clear the screen
  102.  GOSUB CheckForColorCard                  ' see if user has CGA
  103.  IF CGAFlag% = 1 THEN                     ' if user has CGA or better then
  104.   CALL SetColor                           '   load color codes
  105.  ELSE                                     ' if not,
  106.   CALL SetMono                            '   load mono codes
  107.  END IF
  108.  CALL DrawBorder                          ' draw the frame
  109.  LastFileName$ = "MYGAME"                 ' default file name
  110.  primary% = 1                             ' color type one, red-blue-yellow
  111.  Secondary% = 2                           ' color type two, green-violet-orange
  112.  Tertiary% = 3
  113.  Control$ = "HMPKGIQO86247931"            ' legal keys for cursor module
  114.  ColorName$(0) = CHR$(32)                 ' blank space for empty space
  115.   FOR i% = 1 TO 7                         ' read color abbreviations
  116.    READ ColorName$(i%)
  117.   NEXT i%
  118.  DATA R,V,B,G,Y,O,W            
  119.   FOR i% = 1 TO 8                         ' read row and column modifiers for
  120.    READ RowMod%(i%), ColMod%(i%)          '   cursor module
  121.   NEXT i%
  122.  DATA -1,0,0,1,1,0,0,-1,-1,-1,-1,1,1,1,1,-1
  123.  FOR i% = 1 TO 15                         ' read source, destination row/col
  124.   FOR j% = 1 TO 4                         '    for each of the 15 moves in the
  125.    READ TitleMove%(i%, j%)                '    animated title screen
  126.   NEXT j%
  127.  NEXT i%
  128.  DATA 4,8,2,8
  129.  DATA 2,8,4,6
  130.  DATA 3,9,3,7
  131.  DATA 3,7,5,7
  132.  DATA 5,7,3,5
  133.  DATA 4,7,2,5
  134.  DATA 3,6,5,4
  135.  DATA 2,5,4,5
  136.  DATA 4,5,2,3
  137.  DATA 4,6,2,4
  138.  DATA 3,3,3,5
  139.  DATA 5,4,3,4
  140.  DATA 2,3,2,5
  141.  DATA 3,4,3,6
  142.  DATA 2,5,4,7
  143.  
  144.  FOR i% = 0 TO 7                          ' read pane images
  145.   FOR j% = 1 TO 3
  146.    READ pane$(i%, j%)
  147.   NEXT j%
  148.  NEXT i%
  149.  DATA "   "
  150.  DATA "   "
  151.  DATA "   "
  152.  DATA "┌─┐"
  153.  DATA "│R│"
  154.  DATA "└─┘"
  155.  DATA "╔═╗"
  156.  DATA "║V║"
  157.  DATA "╚═╝"
  158.  DATA "┌─┐"
  159.  DATA "│B│"
  160.  DATA "└─┘"
  161.  DATA "╔═╗"
  162.  DATA "║G║"
  163.  DATA "╚═╝"
  164.  DATA "┌─┐"
  165.  DATA "│Y│"
  166.  DATA "└─┘"
  167.  DATA "╔═╗"
  168.  DATA "║O║"
  169.  DATA "╚═╝"
  170.  DATA "╔═╗"
  171.  DATA "║W║"
  172.  DATA "╚═╝"
  173.  
  174.  
  175.  FOR j% = 0 TO 7                       ' Read jump table - jump pane = row,
  176.   FOR s% = 0 TO 7                    '  source pane = col -- in other
  177.    READ JumpTable%(j%, s%)     '  words, if a red pane (1) jumps
  178.   NEXT s%
  179.  NEXT j%                               '  is in row 1, column two -- 3, or
  180.                                           '  blue.  Keep in mind that rows and
  181.                                           '  cols start with zero.
  182.  DATA -1,-1,-1,-1,-1,-1,-1,-1
  183.  DATA -1,0,-1,0,-1,0,-1,-1
  184.  DATA -1,3,0,1,-1,-1,-1,-1
  185.  DATA -1,0,-1,0,-1,0,-1,-1
  186.  DATA -1,-1,-1,5,0,3,-1,-1
  187.  DATA -1,0,-1,0,-1,0,-1,-1
  188.  DATA -1,5,-1,-1,-1,1,0,-1
  189.  DATA -1,4,5,6,1,2,3,0
  190.  
  191.  
  192.  
  193.  FOR d% = 0 TO 7                             ' read destination table; same
  194.   FOR s% = 0 TO 7                          ' scheme as jump table above.
  195.    READ DestTable%(d%, s%)
  196.   NEXT s%
  197.  NEXT d%
  198.  DATA -1,1,2,3,4,5,6,7
  199.  DATA -1,1,-1,2,7,6,-1,-1
  200.  DATA -1,-1,2,-1,-1,7,-1,-1
  201.  DATA -1,2,-1,3,-1,4,7,-1
  202.  DATA -1,7,-1,-1,4,-1,-1,-1
  203.  DATA -1,6,7,4,-1,5,-1,-1
  204.  DATA -1,-1,-1,7,-1,-1,6,-1
  205.  DATA -1,-1,-1,-1,-1,-1,-1,7
  206.  
  207.  
  208.  
  209.  FOR i% = 0 TO 7                               ' read color class -- 0 = blank,
  210.   READ class%(i%)                              '  1 = primary, 2 = secondary, 3 = tertiary
  211.  NEXT i%
  212.  DATA 0,1,2,1,2,1,2,3
  213. RETURN
  214.  
  215. CheckForColorCard:
  216. ON ERROR GOTO NoCGA                     ' try turning on CGA - if it's not
  217. SCREEN 1                                '  there, ON ERROR will barf you out to
  218. SCREEN 0                                '  NoCGA.
  219. WIDTH 80
  220. CGAFlag% = 1
  221.  
  222. NoCGA:
  223. RESUME ExitCGA
  224.  
  225. ExitCGA:                                ' from here on in, any error (hopefully
  226. ON ERROR GOTO TrapError                 ' disk errors during file i/o only)
  227. GOTO NoError                            ' will drop out to here
  228.  
  229. TrapError:
  230.                                   
  231.   IF ERR = 71 THEN                                         ' disk door is open
  232.     inst$ = "Close the drive door and try again, please."
  233.     GOTO GotErr
  234.  END IF
  235.   IF ERR = 61 THEN                                         ' disk is full
  236.     inst$ = "This disk is full -- try another."
  237.     GOTO GotErr
  238.   END IF
  239.   IF ERR = 57 THEN                                         ' disk is bad
  240.     inst$ = "There is something horribly wrong with this disk..."
  241.     GOTO GotErr
  242.   END IF
  243.  
  244.  ' if it gets to here, I've blown it and should be notified...
  245.  
  246.  inst$ = "Error in subprogram " + prog$ + " -- call (408) 296-5529 for help!"
  247.  
  248. GotErr:
  249.  BEEP
  250.  CALL PrintInst(inst$, 10)     ' print the error message
  251.  CALL WaitForKey               ' wait for keypress
  252. RESUME NEXT                    ' resume at statement after error
  253.  
  254. NoError:             
  255. RETURN
  256.  
  257. SUB BackUp
  258.  
  259.  prog$ = "BackUp"
  260.  IF MoveCounter% = 0 THEN            ' no fair trying to back up beyond start
  261.    SOUND 475, .24
  262.    GOTO ExitBackUp
  263.  END IF
  264.  CALL NukeCursor                     ' remove cursor
  265.  m% = MoveCounter%
  266.  JumpValue% = game%(m%, 0)           ' get last jump value to add back on
  267.  Row% = game%(m%, 1)                 ' get source row of last move
  268.  Col% = game%(m%, 2)                 ' get source col of last move
  269.  PaneColor% = game%(m%, 3)           ' get source color of last source pane
  270.  m%(Row%, Col%) = PaneColor%         ' put it back into board matrix
  271.  CALL PrintPane(Row%, Col%)          ' put it back onto screen
  272.  r% = game%(m%, 4)                   ' get jump row of last move
  273.  c% = game%(m%, 5)                   ' get jump col of last move
  274.  PaneColor% = game%(m%, 6)           ' get jump color of last move
  275.  m%(r%, c%) = PaneColor%             ' put it back into board matrix
  276.  CALL PrintPane(r%, c%)              ' put it back onto screen
  277.  r% = game%(m%, 7)                   ' get dest row of last move
  278.  c% = game%(m%, 8)                   ' get dest col of last move
  279.  PaneColor% = game%(m%, 9)           ' get dest color of last move
  280.  m%(r%, c%) = PaneColor%             ' put it back into board matrix
  281.  CALL PrintPane(r%, c%)              ' put it back onto screen
  282.  remainder% = remainder% + JumpValue% ' add jump value to remainder
  283.  CALL PrintScore                     ' put it back onto screen
  284.  MoveCounter% = MoveCounter% - 2     ' subtract one from move counter
  285.  CALL PrintMoves                     ' put it back onto screen
  286.  BackupCount% = BackupCount% + 1     ' increment backup count
  287.  CALL PrintBackups                   ' put it onto screen
  288.  
  289. ExitBackUp:
  290.  
  291. END SUB
  292.  
  293. SUB BackUpAllTheWay
  294.  
  295.  prog$ = "BackUpAllTheWay"
  296.  CALL NukeHelp                           ' remove help options
  297.  inst$ = "Rewinding..."                  ' load instruction line
  298.  CALL PrintInst(inst$, 15)               ' print instruction line
  299.  FOR b% = MoveCounter% TO 1 STEP -1      ' do this until move < 1
  300.   CALL BackUp                            ' back up one move
  301.  NEXT b%
  302.  BackupCount% = 0                        ' reset backup count
  303.  CALL PrintBackups                       ' print backup count
  304.  
  305. END SUB
  306.  
  307. SUB CheckMove
  308.  
  309.  prog$ = "CheckMove"
  310.  BadFlag% = 0                                            ' reset bad flag
  311.  JumpRow% = (OrgRow% + DestRow%) / 2                     ' get jump row
  312.  JumpCol% = (OrgCol% + DestCol%) / 2                     ' get jump col
  313.  OrgColor% = m%(OrgRow%, OrgCol%)                        ' get org color
  314.  JumpColor% = m%(JumpRow%, JumpCol%)                     ' get jump color
  315.  DestColor% = m%(DestRow%, DestCol%)                     ' get dest color
  316.  OrgClass% = class%(OrgColor%)                           ' get org class
  317.  JumpClass% = class%(JumpColor%)                         ' get jump class
  318.  DestClass% = class%(DestColor%)                         ' get dest class
  319.  NewJump% = JumpTable%(JumpColor%, OrgColor%)          ' get jump result
  320.  NewDest% = DestTable%(DestColor%, OrgColor%)          ' get dest result
  321.   IF NewJump% = -1 OR NewDest% = -1 THEN BadFlag% = 1    ' if jump result or
  322.                                                          '  dest result is -1
  323.                                                          '  in our tables,
  324.                                                          '  it's a bad move
  325.  
  326. ExitCheck:
  327.  
  328. END SUB
  329.  
  330. SUB CheckStuck
  331.  
  332.  prog$ = "CheckStuck"
  333.  FOR tr% = 1 TO 6                            ' check all rows
  334.   FOR tc% = 1 TO 12                          ' check all cols
  335.     IF m%(tr%, tc%) = 0 THEN GOTO SkipSpace  ' if pane is empty, skip it
  336.    OrgRow% = tr%                             ' you are checking org row
  337.    OrgCol% = tc%                             ' you are checking org col
  338.    FOR tmove% = 1 TO 8                       ' check all eight moves
  339.     JumpRow% = OrgRow% + RowMod%(tmove%)     ' get jump row
  340.     JumpCol% = OrgCol% + ColMod%(tmove%)     ' get jump col
  341.     DestRow% = JumpRow% + RowMod%(tmove%)    ' get dest row
  342.     DestCol% = JumpCol% + ColMod%(tmove%)    ' get dest col
  343.      IF JumpRow% < 1 OR JumpRow% > 6 OR JumpCol% < 1 OR JumpCol% > 12 THEN
  344.       GOTO SkipMove                          ' you are going offboard
  345.      END IF
  346.      IF DestRow% < 1 OR DestRow% > 6 OR DestCol% < 1 OR DestCol% > 12 THEN
  347.       GOTO SkipMove                          ' you are going offboard
  348.      END IF
  349.      CALL CheckMove                          ' check the move
  350.     IF BadFlag% = 0 THEN GOTO ExitCheckStuck ' if the move is good, get out
  351.  
  352. SkipMove:
  353.   NEXT tmove%                                ' next move
  354.  
  355. SkipSpace:
  356.  NEXT tc%                                    ' next col
  357. NEXT tr%                                     ' next row
  358.  
  359. CALL Lose                                    ' you are stuck - say so
  360.  
  361. ExitCheckStuck:
  362.  
  363. END SUB
  364.  
  365. SUB ClearBoard
  366.  
  367.  prog$ = "ClearBoard"
  368.  
  369.  FOR r% = 4 TO 21               ' clear board by printing spaces
  370.   LOCATE r%, 23                 ' over existing panes
  371.   PRINT SPACE$(36);
  372.  NEXT r%
  373.  
  374. END SUB
  375.  
  376. SUB cursor
  377.  
  378.  prog$ = "Cursor"
  379.  hot$ = inst$                                   ' save inst line in hot$
  380.  
  381. MoveCursor:                          
  382.  LOCATE 3 + (Row% * 3 - 1), 21 + (Col% * 3)
  383.  COLOR 15, 0
  384.  PRINT CHR$(219);                               ' print cursor character
  385.  
  386. CursorLoop:
  387.  in$ = UCASE$(INKEY$)
  388.   IF in$ = "" THEN GOTO CursorLoop              ' no key pressed - go back
  389.   IF LEN(in$) = 2 OR VAL(in$) > 0 THEN          ' arrow key pressed
  390.      in$ = RIGHT$(in$, 1)
  391.      GOSUB Control
  392.      GOTO MoveCursor
  393.   END IF
  394.   IF in$ = CHR$(13) THEN GOTO ExitCursor        ' Enter pressed
  395.   IF DestFlag% = 1 THEN                         ' do Esc only if you are
  396.    IF in$ = CHR$(27) THEN AbortMoveFlag% = 1    ' picking destination
  397.    GOSUB AbortMove
  398.    GOTO ExitCursor
  399.   END IF
  400.   IF DestFlag% = 0 THEN                         ' do following only on source
  401.    IF in$ = "B" THEN CALL BackUp                ' back up
  402.    IF in$ = "Q" THEN                            ' quit
  403.     CALL Quit
  404.     CALL HotKeyRecovery(hot$)
  405.    END IF
  406.    IF in$ = "P" THEN                            ' panic
  407.     CALL Panic
  408.     CALL RedrawBoard
  409.     CALL HotKeyRecovery(hot$)
  410.    END IF
  411.    IF in$ = "E" THEN                            ' examples
  412.     CALL Rules
  413.     CALL RedrawBoard
  414.     CALL HotKeyRecovery(hot$)
  415.    END IF
  416.    IF in$ = "L" THEN                            ' load
  417.     CALL Load
  418.     CALL ClearBoard
  419.     CALL RedrawBoard
  420.     CALL HotKeyRecovery(hot$)
  421.    END IF
  422.    IF in$ = "S" THEN                            ' save
  423.     CALL save
  424.     CALL HotKeyRecovery(hot$)
  425.    END IF
  426.    IF in$ = "H" THEN                            ' hint
  427.     CALL Hint
  428.     CALL HotKeyRecovery(hot$)
  429.    END IF
  430.    IF in$ = "R" THEN                            ' rewind
  431.     CALL BackUpAllTheWay
  432.     CALL HotKeyRecovery(hot$)
  433.    END IF
  434.   END IF
  435.   IF StartOverFlag% = 1 THEN GOTO ExitCursor    ' get this from quit routine
  436. GOTO MoveCursor
  437.  
  438. Control:
  439.  FOR a% = 1 TO LEN(Control$)
  440.   IF in$ = MID$(Control$, a%, 1) THEN GOTO GotControl ' found legal arrow$
  441.  NEXT a%
  442. RETURN
  443.  
  444. GotControl:
  445.   IF a% > 8 THEN a% = a% - 8                          ' num lock is down
  446.  trow% = Row% + RowMod%(a%)                           '
  447.   IF DestFlag% = 1 THEN trow% = trow% + RowMod%(a%)
  448.   IF trow% < 1 THEN trow% = 6
  449.   IF trow% > 6 THEN trow% = 1
  450.  tcol% = Col% + ColMod%(a%)
  451.   IF DestFlag% = 1 THEN tcol% = tcol% + ColMod%(a%)
  452.   IF tcol% < 1 THEN tcol% = 12
  453.   IF tcol% > 12 THEN tcol% = 1
  454.  CALL NukeCursor
  455.  Row% = trow%
  456.  Col% = tcol%
  457. RETURN
  458.  
  459. AbortMove:
  460.   IF Row% = OrgRow% AND Col% = OrgCol% THEN RETURN
  461.  CALL NukeCursor
  462.  Row% = OrgRow%
  463.  Col% = OrgCol%
  464. RETURN
  465.  
  466. ExitCursor:
  467.  
  468. END SUB
  469.  
  470. SUB DrawBoard
  471.  
  472.  prog$ = "DrawBoard"
  473.  
  474.  FOR r% = 1 TO 6               ' clear board
  475.   FOR c% = 1 TO 12
  476.    m%(r%, c%) = 0
  477.   NEXT c%
  478.  NEXT r%
  479.  
  480.  RANDOMIZE TIMER                             ' randomize on new seed
  481.  PaneColor% = 0
  482.  FOR i% = 1 TO 72                            ' randomize each of 72 panes
  483. GetRnd:
  484.   rr% = INT(RND * 6) + 1                     ' get rnd row
  485.   rc% = INT(RND * 12) + 1                    ' get rnd col
  486.    IF m%(rr%, rc%) <> 0 THEN GOTO GetRnd     ' if row, col occupied, try again
  487.   PaneColor% = PaneColor% + 1                ' print a different pane each time
  488.   IF PaneColor% > 6 THEN PaneColor% = 1      ' don't go over pane color 6
  489.   m%(rr%, rc%) = PaneColor%                  ' stuff pane into board
  490.   CALL PrintPane(rr%, rc%)                   ' print pane
  491.  NEXT i%
  492.  
  493.  remainder% = 108       ' reset score
  494.  CALL PrintScore        ' print score
  495.  MoveCounter% = -1      ' reset move counter
  496.  CALL PrintMoves        ' print move counter
  497.  BackupCount% = 0       ' reset backup counter
  498.  CALL PrintBackups      ' print backup counter
  499.  
  500. END SUB
  501.  
  502. SUB DrawBorder
  503.  
  504.  prog$ = "DrawBorder"
  505.  CLS
  506.  COLOR 15                    ' what this stuff does should be fairly obvious
  507.  LOCATE 1, 1
  508.  PRINT "Stained Glass v910116        Copyright Kent Brewster 1991 -- all rights reserved"
  509.  LOCATE 3, 22
  510.  PRINT "╔════════════════════════════════════╗"
  511.  FOR i% = 4 TO 21
  512.  LOCATE i%, 22
  513.  PRINT "║                                    ║"
  514.  NEXT i%
  515.  LOCATE 22, 22
  516.  PRINT "╚════════════════════════════════════╝"
  517.  
  518. END SUB
  519.  
  520. SUB FigureScore
  521.  
  522.  prog$ = "FigureScore"
  523.                                  ' figure out value of panes to be removed
  524.   
  525.    JumpValue% = 1
  526.  
  527.    IF OrgClass% = primary% AND OrgColor% = DestColor% THEN
  528.     JumpValue% = 2
  529.    END IF
  530.    IF OrgClass% = primary% THEN GOTO GotJumpValue
  531.  
  532.    JumpValue% = 2
  533.    IF OrgClass% = Secondary% AND DestColor% = OrgColor% THEN
  534.     JumpValue% = 4
  535.    END IF
  536.    IF OrgClass% = Secondary% THEN GOTO GotJumpValue
  537.  
  538.    JumpValue% = 3
  539.     IF OrgColor% = DestColor% THEN
  540.      JumpValue% = 6
  541.     END IF
  542.  
  543. GotJumpValue:
  544.  
  545.   remainder% = remainder% - JumpValue%
  546.  
  547. END SUB
  548.  
  549. SUB Hint
  550.  
  551.  prog$ = "Hint"
  552.   IF remainder% = 1 THEN GOTO ExitHint          ' end of game, no hint needed
  553.  inst$ = "Press H again for another hint or any other key to continue."
  554.  InColor% = 15                                  ' print hint message
  555.  CALL PrintInst(inst$, InColor%)
  556.  CALL NukeHelp                                  ' get rid of help options
  557. HintLoop:                            
  558.  FOR tr% = 1 TO 6                               ' check all rows
  559.   FOR tc% = 1 TO 12                             ' check all cols
  560.    IF m%(tr%, tc%) = 0 THEN GOTO SS1            ' if no pane there, skip it
  561.    OrgRow% = tr%                                ' set OrgRow to temp row
  562.    OrgCol% = tc%                                ' set OrgCol to temp col
  563.    FOR tmove% = 1 TO 8                          ' do all 8 possible moves
  564.     JumpRow% = OrgRow% + RowMod%(tmove%)        ' get jump row
  565.     JumpCol% = OrgCol% + ColMod%(tmove%)        ' get jump col
  566.     DestRow% = JumpRow% + RowMod%(tmove%)       ' get dest row
  567.     DestCol% = JumpCol% + ColMod%(tmove%)       ' get dest col
  568.      IF JumpRow% < 1 OR JumpRow% > 6 OR JumpCol% < 1 OR JumpCol% > 12 THEN GOTO SM1
  569.      IF DestRow% < 1 OR DestRow% > 6 OR DestCol% < 1 OR DestCol% > 12 THEN GOTO SM1
  570.                                                 ' if move is off board, skip
  571.     CALL CheckMove                              ' check it
  572.      IF BadFlag% = 0 AND tc% <> hc% AND tr% <> hr% THEN GOTO FPM
  573.                                                 ' found a move - wait for key
  574. SM1:                                 
  575.   NEXT tmove%                                   ' next move
  576. SS1:                                 
  577.  NEXT tc%                                       ' next col   
  578. NEXT tr%                                        ' next row
  579. GOTO HintLoop                                   ' go back and get another
  580.  
  581. FPM:                                 
  582.  CALL NukeCursor                                ' remove cursor from old loc
  583.  Row% = tr%                                     ' set row for cursor
  584.  Col% = tc%                                     ' set col for cursor
  585.  LOCATE 3 + (Row% * 3 - 1), 21 + (Col% * 3)     ' get actual screen position
  586.  COLOR 15, 0                                    ' set color
  587.  PRINT CHR$(219);                               ' print cursor character
  588. HintInLoop:                          
  589.  in$ = UCASE$(INKEY$)                           ' wait for key
  590.   IF in$ = "" THEN GOTO HintInLoop              ' if none, get another
  591.   IF in$ <> "H" THEN GOTO ExitHint              ' if not H, get another
  592. GOTO SS1
  593.  
  594. ExitHint:
  595.  CALL PrintHelp                                 ' reprint help menu
  596.  
  597. END SUB
  598.  
  599. SUB HotKeyRecovery (hot$)
  600.  
  601.  prog$ = "HotKeyRecovery"
  602.  
  603.  CALL PrintInst(hot$, InColor%)         ' print old inst message you took off
  604.  CALL PrintHelp                         ' replace help menu
  605.  
  606. END SUB
  607.  
  608. SUB Load
  609.  
  610.  prog$ = "Load"
  611.  
  612.  CALL NukeHelp                                  ' remove help menu
  613.  InColor% = 15
  614.  inst$ = "Enter game file to load or press <Esc> to abort."
  615.  CALL PrintInst(inst$, InColor%)                ' print message     
  616.  InRow% = 24                                    ' set input row
  617.  InCol% = 36                                    ' set input col
  618.  InLen% = 8                                     ' set input length
  619.  InDef$ = LastFileName$                         ' set input default
  620.  CALL MagicInput(InRow%, InCol%, InLen%, InDef$, in$)   ' do MagicInput
  621.  in$ = UCASE$(in$)                              ' set in$ to uppercase
  622.   IF in$ = "" THEN GOTO ExitLoad                ' if no input, quit             
  623.  LastFileName$ = in$                            ' set default to in$
  624.  sv$ = in$ + ".SAV"                             ' add file extension
  625.  OPEN sv$ FOR RANDOM AS #1 LEN = 13             ' open it
  626.   FIELD #1, 13 AS in$                           ' set field
  627.  GET #1, 1                                      ' get first record
  628.   r% = VAL(in$)                                 ' set r to value of first rec
  629.    IF r% = 0 THEN GOSUB BadLoadFile             ' if r = 0 then it's a bad file
  630.  remainder% = r%                                ' set remainder% to r
  631.  GET #1, 2                                      ' get next record
  632.  MoveCounter% = VAL(in$)                        ' set move counter to next rec
  633.  GET #1, 3                                      ' get next record
  634.  BackupCount% = VAL(in$)                        ' set backup count to next rec
  635.  FOR r% = 1 TO 6                                ' get current picture of board
  636.   GET #1, r% + 3
  637.    FOR c% = 1 TO 12
  638.     m%(r%, c%) = VAL(MID$(in$, c%, 1))
  639.    NEXT c%
  640.  NEXT r%
  641.  FOR i% = 1 TO MoveCounter%                     ' get all moves that lead to
  642.   GET #1, i% + 9                                '   current picture of board
  643.   game%(i%, 0) = VAL(MID$(in$, 1, 1))           ' jump value
  644.   game%(i%, 1) = VAL(MID$(in$, 2, 1))           ' source row
  645.   game%(i%, 2) = VAL(MID$(in$, 3, 2))           ' source col
  646.   game%(i%, 3) = VAL(MID$(in$, 5, 1))           ' source color
  647.   game%(i%, 4) = VAL(MID$(in$, 6, 1))           ' jump row
  648.   game%(i%, 5) = VAL(MID$(in$, 7, 2))           ' jump col
  649.   game%(i%, 6) = VAL(MID$(in$, 9, 1))           ' jump color
  650.   game%(i%, 7) = VAL(MID$(in$, 10, 1))          ' dest row
  651.   game%(i%, 8) = VAL(MID$(in$, 11, 2))          ' dest col
  652.   game%(i%, 9) = VAL(MID$(in$, 13, 1))          ' dest color
  653.  NEXT i%
  654.  CLOSE #1
  655.  Row% = game%(MoveCounter%, 7)                  ' get current cursor row
  656.  Col% = game%(MoveCounter%, 8)                  ' get current cursor col
  657.   IF Row% = 0 OR Col% = 0 THEN                  ' set to one if either is 0
  658.     Row% = 1
  659.     Col% = 1
  660.   END IF
  661.  MoveCounter% = MoveCounter% - 1                ' reset move counter
  662.  CALL PrintMoves                                ' print it
  663.  CALL PrintScore                                ' print score
  664.  CALL PrintBackups                              ' print backups
  665. GOTO ExitLoad
  666.  
  667. BadLoadFile:
  668.  inst$ = "Sorry -- I can't find " + sv$ + ".  Press any key to continue."
  669.  InColor% = 15
  670.  CALL PrintInst(inst$, InColor%)                ' print bad file message
  671.  CLOSE #1
  672.  KILL sv$                                       ' get rid of bad file
  673. BadLoadLoop:
  674.  IF INKEY$ = "" THEN GOTO BadLoadLoop           ' wait for a key
  675.  
  676. ExitLoad:
  677.  LOCATE 24, 36                                  ' remove file name
  678.  PRINT "        ";
  679.  CALL PrintHelp                                 ' reprint help menu
  680.  
  681. END SUB
  682.  
  683. SUB Lose
  684.  
  685.  prog$ = "Lose"
  686.  CALL NukeHelp                          ' remove help menu
  687.  SOUND 475, .24                         ' thock
  688.  inst$ = "Sorry, but you are stuck.  B)ack up, N)ew game, L)oad game, R)ewind, or Q)uit?"
  689.  InColor% = ColorVal%(5)
  690.  CALL PrintInst(inst$, InColor%)        ' print stuck message     
  691.  
  692. LoseLoop:
  693.  in$ = UCASE$(INKEY$)                   ' convert in$ to upper case
  694.   IF in$ = "" THEN GOTO LoseLoop        ' if nothing, try again
  695.   IF in$ = "N" THEN                     ' new game
  696.    StartOverFlag% = 1
  697.    GOTO ExitStuck
  698.   END IF
  699.   IF in$ = "Q" THEN                     ' quit
  700.    CALL Quit
  701.    StartOverFlag% = 1
  702.    GOTO ExitStuck
  703.   END IF
  704.   IF in$ = "R" THEN                     ' rewind
  705.    CALL BackUpAllTheWay
  706.    GOTO ExitStuck
  707.   END IF
  708.   IF in$ = "B" THEN                     ' back up
  709.    CALL BackUp
  710.    GOTO ExitStuck
  711.   END IF
  712.   IF in$ = "L" THEN                     ' load
  713.    CALL Load
  714.    CALL ClearBoard
  715.    CALL RedrawBoard
  716.    GOTO ExitStuck
  717.   END IF
  718.  SOUND 475, .24                         ' thock - bad input
  719. GOTO LoseLoop                           ' go back and try again
  720.                                         
  721. ExitStuck:
  722.  CALL PrintHelp                         ' reprint help menu
  723.  
  724. END SUB
  725.  
  726. SUB MagicInput (InRow%, InCol%, InLen%, InDef$, in$)
  727.  
  728. prog$ = "MagicInput"
  729.  sf% = 1
  730. MagicInput:
  731.  CursorLoc = 0
  732.  GOSUB PrintLimits                      ' print ">       <" around input area
  733.  GOSUB ClearInLine                      ' clear that space
  734.  GOSUB PrintInDef                       ' print the default string
  735.  GOSUB PrintCursor                      ' print cursor
  736.  GOSUB MInLoop                          ' get input
  737.  GOSUB BuildIn                          ' convert screen characters to input
  738.  GOSUB ClearInLine                      ' clear input space
  739.  GOSUB PrintInput                       ' print input stuff
  740.  GOSUB EraseLimits                      ' remove limits
  741. GOTO ExitMagicInput                     ' get out
  742.  
  743. MInLoop:
  744.  in$ = INKEY$
  745.   IF in$ = "" THEN GOTO MInLoop
  746.   IF in$ = CHR$(13) THEN RETURN                ' user hit enter - you are done
  747.   IF in$ = CHR$(8) THEN GOSUB CursorBack       ' back space key      
  748.   IF in$ = CHR$(3) THEN GOSUB ClearInLine      ' control - C
  749.   IF in$ = CHR$(27) THEN                      ' Esc
  750.    in$ = ""
  751.    GOSUB EraseLimits
  752.    GOTO ExitMagicInput
  753.   END IF
  754.  a% = ASC(in$)                                 ' convert in$ to ascii value
  755.   IF (a% > 47 AND a% < 58) OR a% = 32 OR (a% > 64 AND a% < 91) OR (a% > 96 AND a% < 123) THEN GOSUB PrintChar
  756. GOTO MInLoop                                   ' if ascii value is char, print
  757.  
  758. CursorBack:
  759.  GOSUB EraseCursor                             ' destructive back space
  760.  CursorLoc% = CursorLoc% - 1                   ' back cursor up
  761.   IF CursorLoc% < 0 THEN CursorLoc% = InLen% - 1  ' move cursor to end if -1
  762.  GOSUB PrintCursor                             ' print cursor
  763. RETURN
  764.  
  765. CursorForward:
  766.  GOSUB EraseCursor                             ' destructive frontspace
  767.  CursorLoc% = CursorLoc% + 1
  768.   IF CursorLoc% > InLen% - 1 THEN CursorLoc% = 0
  769.  GOSUB PrintCursor
  770. RETURN
  771.  
  772. PrintChar:
  773.   IF sf% = 1 THEN                              ' on first keypress, clear line
  774.    sf% = 0
  775.    GOSUB ClearInLine
  776.   END IF
  777.  GOSUB EraseCursor                             ' erase cursor
  778.  LOCATE InRow%, InCol% + CursorLoc%            ' print input char
  779.  PRINT in$;
  780.  GOSUB CursorForward                           ' move cursor forward              
  781.  GOSUB PrintCursor
  782. RETURN
  783.  
  784. BuildIn:                                        ' build input line from screen
  785.  in$ = ""
  786.  FOR i% = 0 TO InLen% - 1
  787.   in$ = in$ + CHR$(SCREEN(InRow%, InCol% + i%))
  788.  NEXT i%
  789.   IF in$ = SPACE$(InLen%) THEN in$ = ""
  790.  in$ = LTRIM$(RTRIM$(in$))                      ' remove spaces
  791. RETURN
  792.  
  793. PrintCursor:
  794.  LOCATE InRow%, InCol% + CursorLoc%
  795.  COLOR 0, 7                                     ' reverse colors
  796.  PRINT CHR$(SCREEN(InRow%, InCol% + CursorLoc%));  ' print what's there
  797.  COLOR 7, 0                                     ' normalize colors
  798. RETURN
  799.  
  800. EraseCursor:                                    ' erase cursor
  801.  LOCATE InRow%, InCol% + CursorLoc%
  802.  PRINT CHR$(SCREEN(InRow%, InCol% + CursorLoc%));
  803. RETURN
  804.  
  805. EraseLimits:                                    ' remove > and <
  806.  LOCATE InRow%, InCol% - 1
  807.  PRINT " ";
  808.  LOCATE InRow%, InCol% + InLen%
  809.  PRINT " ";
  810. RETURN
  811.  
  812. PrintInput:                                     ' print input string
  813.  LOCATE InRow%, InCol%
  814.  PRINT in$;
  815. RETURN
  816.  
  817. ClearInLine:                                    ' clear input area
  818.  LOCATE InRow%, InCol%
  819.  PRINT SPACE$(InLen%);
  820. RETURN
  821.  
  822. PrintLimits:                                    ' print limits
  823.  LOCATE InRow%, InCol% - 1
  824.  PRINT ">";
  825.  LOCATE InRow%, InCol% + InLen%
  826.  PRINT "<";
  827. RETURN
  828.  
  829. PrintInDef:                                     ' print default string
  830.  LOCATE InRow%, InCol%
  831.  PRINT InDef$;
  832. RETURN
  833.  
  834. ExitMagicInput:
  835.  
  836. END SUB
  837.  
  838. SUB Move
  839.  
  840.  prog$ = "Move"
  841.  CALL FigureScore                               ' figure score
  842.  CALL PrintScore                                ' print score
  843.  CALL PrintMoves                                ' print move counter
  844.   IF MemFlag% = 1 THEN GOTO DontRememberThisMove  ' don't add move to game
  845.  m% = MoveCounter%                                '    during demo
  846.  game%(m%, 0) = JumpValue%
  847.  game%(m%, 1) = OrgRow%
  848.  game%(m%, 2) = OrgCol%
  849.  game%(m%, 3) = OrgColor%
  850.  game%(m%, 4) = JumpRow%
  851.  game%(m%, 5) = JumpCol%
  852.  game%(m%, 6) = JumpColor%
  853.  game%(m%, 7) = DestRow%
  854.  game%(m%, 8) = DestCol%
  855.  game%(m%, 9) = DestColor%
  856.  
  857. DontRememberThisMove:                 
  858.   r% = OrgRow%                                  ' remove source pane
  859.   c% = OrgCol%
  860.   m%(r%, c%) = 0
  861.   CALL PrintPane(r%, c%)
  862.    IF JumpClass% = primary% OR JumpColor% = OrgColor% THEN
  863.   r% = JumpRow%
  864.   c% = JumpCol%
  865.   m%(r%, c%) = 0                                ' remove jump pane
  866.   CALL PrintPane(r%, c%)
  867.   GOTO DoDestination
  868.  END IF
  869.  JumpColor% = JumpTable%(JumpColor%, OrgColor%)
  870.  r% = JumpRow%
  871.  c% = JumpCol%
  872.  PaneColor% = JumpColor%
  873.  m%(r%, c%) = PaneColor%
  874.  CALL PrintPane(r%, c%)                         ' change jump pane
  875.  
  876. DoDestination:
  877.  IF OrgColor% = DestColor% THEN GOTO ExitMove
  878.  IF DestColor% = 0 THEN
  879.    DestColor% = OrgColor%
  880.    GOTO PrintDest
  881.  END IF
  882.  DestColor% = DestTable%(DestColor%, OrgColor%)' change dest pane
  883.  
  884. PrintDest:
  885.    r% = DestRow%
  886.    c% = DestCol%
  887.    PaneColor% = DestColor%
  888.    m%(r%, c%) = PaneColor%
  889.    CALL PrintPane(r%, c%)                       ' print dest pane
  890.  
  891. ExitMove:
  892.  
  893. END SUB
  894.  
  895. SUB NukeCursor
  896.  
  897.  prog$ = "NukeCursor"                           ' remove cursor
  898.  LOCATE 3 + (Row% * 3 - 1), 21 + (Col% * 3)     ' locate center of pane
  899.  COLOR ColorVal%(m%(Row%, Col%)), 0             ' change color to pane color
  900.  PRINT ColorName$(m%(Row%, Col%));              ' print pane letter
  901.  
  902. END SUB
  903.  
  904. SUB NukeHelp
  905.  
  906.  prog$ = "NukeHelp"
  907.  FOR i% = 5 TO 21 STEP 2                        ' print blank lines
  908.   LOCATE i%, 68                                 '    where help menu was
  909.   PRINT SPACE$(12);
  910.  NEXT i%
  911.  
  912. END SUB
  913.  
  914. SUB Panic
  915.  
  916.  prog$ = "Panic"
  917.  CLS
  918. PanicLoop:
  919.  COLOR 7, 0
  920.  INPUT "A:\>", in$                      ' print phoney disk prompt
  921.  IF in$ = "" THEN GOTO PanicLoop        ' don't do anything on Enter alone
  922.  IF UCASE$(in$) = "DIR" THEN            ' directory disk A if in$ = "DIR"
  923.    SHELL "DIR A:"
  924.    GOTO PanicLoop
  925.  END IF
  926.  IF UCASE$(in$) = "SG" THEN             ' exit to game if in$ = "SG"
  927.    GOTO ExitPanic
  928.  ELSE
  929.   PRINT "Bad command or file name"      ' print error on anything else
  930.  END IF
  931.  PRINT
  932. GOTO PanicLoop
  933.  
  934. ExitPanic:
  935.  CALL DrawBorder                        ' redraw board on exit
  936.  CALL PrintScore
  937.  InColor% = 15
  938.  CALL PrintInst(inst$, InColor%)
  939.  MoveCounter% = MoveCounter% - 1
  940.  CALL PrintMoves
  941.  CALL PrintBackups
  942. END SUB
  943.  
  944. SUB PickDestination (DestRow%, DestCol%)
  945.  
  946.  prog$ = "PickDestination"
  947.  CALL NukeHelp                                  ' remove help menus
  948.  inst$ = "Choose a flashing destination point and press Enter.  Press Esc to go back."
  949.  InColor% = 15
  950.  CALL PrintInst(inst$, InColor%)                ' print instruction line
  951.  
  952. DestLoop:
  953.  DestFlag% = 1                                  ' for cursor routine
  954.  CALL cursor                                    ' do cursor routine
  955.  DestFlag% = 0                                  ' reset for source cursor
  956.   IF AbortMoveFlag% = 1 THEN GOTO GotGoodMove   ' if Esc then abort move
  957.  DestRow% = Row%                                ' set dest row to cursor row
  958.  DestCol% = Col%                                ' set dest col to cursor col
  959.  FOR tmove% = 1 TO 8                            ' check move
  960.   IF GoodMove%(tmove%, 1) = DestRow% AND GoodMove%(tmove%, 2) = DestCol% THEN GOTO GotGoodMove
  961.  NEXT tmove%
  962. GOTO DestLoop                                   ' move was no good - try again
  963.  
  964. GotGoodMove:
  965.  FOR tmove% = 1 TO 8                            ' un-flash flashing panes
  966.   IF GoodMove%(tmove%, 1) = 0 THEN GOTO SkipReplace ' dont bother with bad move
  967.   Row% = GoodMove%(tmove%, 1)                   ' set row to flashing row
  968.   Col% = GoodMove%(tmove%, 2)                   ' set col to flashing col
  969.   CALL NukeCursor                               ' remove flashing pane
  970. SkipReplace:                          
  971.  NEXT tmove%                                    ' next one
  972.  
  973.   IF AbortMoveFlag% = 1 THEN                    ' if abort move, reset row, col
  974.    Row% = OrgRow%
  975.    Col% = OrgCol%
  976.    GOTO ExitPickDest
  977.   END IF
  978.  
  979.  Row% = DestRow%                                ' reset row
  980.  Col% = DestCol%                                ' reset col
  981.  
  982. ExitPickDest:
  983.  
  984. CALL PrintHelp                                  ' put help info back
  985.  
  986. END SUB
  987.  
  988. SUB PickOrigin (OrgRow%, OrgCol%)
  989.  
  990. prog$ = "PickOrigin"
  991.  
  992. PickStart:
  993.  inst$ = "Choose a point of origin, using the arrow keys, and press Enter."
  994.  InColor% = 15
  995.  CALL PrintInst(inst$, InColor%)                ' print message             
  996.  CALL cursor                                    ' get source location
  997.  IF StartOverFlag% = 1 THEN GOTO ExitPickOrigin ' restart if restart requested
  998.  OrgRow% = Row%                                 ' set source row to cursor row
  999.  OrgCol% = Col%                                 ' set source col to cursor col
  1000.  IF m%(OrgRow%, OrgCol%) = 0 THEN               ' no fair moving empty space
  1001.   inst$ = "Please choose an occupied space.  Press any key to continue."
  1002.   InColor% = ColorVal%(5)
  1003.   CALL PrintInst(inst$, InColor%)               ' print message
  1004.   SOUND 475, .24                                ' thock
  1005.   CALL WaitForKey                               ' wait for key
  1006.   GOTO PickStart                                ' start over
  1007.  END IF
  1008.   FoundMoveFlag% = 0
  1009.    FOR tmove% = 1 TO 8                          ' find all moves this pane has
  1010.     GoodMove%(tmove%, 1) = 0                    ' reset good row
  1011.     GoodMove%(tmove%, 2) = 0                    ' reset good col
  1012.     JumpRow% = OrgRow% + RowMod%(tmove%)        ' set jump row
  1013.     JumpCol% = OrgCol% + ColMod%(tmove%)        ' set jump col
  1014.     DestRow% = JumpRow% + RowMod%(tmove%)       ' set dest row
  1015.     DestCol% = JumpCol% + ColMod%(tmove%)       ' set dest col
  1016.      IF JumpRow% < 1 OR JumpRow% > 6 OR JumpCol% < 1 OR JumpCol% > 12 THEN GOTO SM
  1017.      IF DestRow% < 1 OR DestRow% > 6 OR DestCol% < 1 OR DestCol% > 12 THEN GOTO SM
  1018.                                                 ' if dest or jump is offscreen,
  1019.                                                 '   puke
  1020.     CALL CheckMove                              ' check this move
  1021.      IF BadFlag% = 0 THEN
  1022.       FoundMoveFlag% = 1                        ' if move ok, set found flag
  1023.       GoodMove%(tmove%, 1) = DestRow%           ' set good row    
  1024.       GoodMove%(tmove%, 2) = DestCol%           ' set good col
  1025.       PaneColor% = m%(DestRow%, DestCol%)       ' get pane color
  1026.        IF PaneColor% > 0 THEN                   '
  1027.         LOCATE 3 + (DestRow% * 3 - 1), 21 + (DestCol% * 3)
  1028.         COLOR ColorVal%(PaneColor%) + 16        ' if pane > 0, flash it
  1029.         PRINT ColorName$(PaneColor%);
  1030.        ELSE
  1031.         LOCATE 3 + (DestRow% * 3 - 1), 21 + (DestCol% * 3)
  1032.         COLOR 31, 0                             ' if pane = 0, flash hole
  1033.         PRINT CHR$(240);
  1034.        END IF
  1035.      END IF
  1036. SM:
  1037.    NEXT tmove%                                  ' try next move
  1038.   IF FoundMoveFlag% = 1 THEN GOTO TagSource     ' skip following if found move
  1039.  inst$ = "That piece cannot make a legal move.  Press any key to continue."
  1040.  InColor% = ColorVal%(5)
  1041.  SOUND 475, .24                                 ' thock
  1042.  CALL PrintInst(inst$, InColor%)                ' print bad msg
  1043.  CALL WaitForKey                                ' wait for key
  1044. GOTO PickStart                                  ' try again
  1045.  
  1046. TagSource:                                      ' turn source pane white
  1047.  r% = OrgRow%
  1048.  c% = OrgCol%
  1049.  PaneColor% = m%(r%, c%)
  1050.  COLOR 15
  1051.   FOR p% = 1 TO 3
  1052.    PaneLineRow% = 3 + ((r% - 1) * 3 + p%)
  1053.    PaneCol% = 21 + (c% * 3 - 1)
  1054.    LOCATE PaneLineRow%, PaneCol%
  1055.    PRINT pane$(PaneColor%, p%);
  1056.   NEXT p%
  1057.  
  1058. ExitPickOrigin:
  1059.  
  1060. END SUB
  1061.  
  1062. SUB PrintBackups
  1063.  
  1064.  prog$ = "PrintBackups"
  1065.  COLOR 15, 0
  1066.  LOCATE 17, 6                   ' print backup count
  1067.  PRINT "Backups:"
  1068.  LOCATE 19, 8
  1069.  PRINT BackupCount%; "  ";
  1070.  
  1071. END SUB
  1072.  
  1073. SUB PrintHelp
  1074.  
  1075.  prog$ = "PrintHelp"
  1076.  COLOR 15, 0                            ' print help menu
  1077.  LOCATE 6, 68
  1078.  PRINT "B)ack Up"
  1079.  LOCATE 8, 68
  1080.  PRINT "P)anic"
  1081.  LOCATE 10, 68
  1082.  PRINT "E)xamples"
  1083.  LOCATE 12, 68
  1084.  PRINT "L)oad"
  1085.  LOCATE 14, 68
  1086.  PRINT "S)ave"
  1087.  LOCATE 16, 68
  1088.  PRINT "H)int"
  1089.  LOCATE 18, 68
  1090.  PRINT "R)ewind"
  1091.  LOCATE 20, 68
  1092.  PRINT "Q)uit"
  1093.  
  1094. END SUB
  1095.  
  1096. SUB PrintInst (inst$, InColor%)
  1097.  
  1098.  prog$ = "PrintInst"
  1099.  LOCATE 25, 1                   ' clear bottom line
  1100.  PRINT SPACE$(80);
  1101.  COLOR InColor%, 0
  1102.  center% = 40 - INT((LEN(inst$) / 2)) + 1       ' figure center location
  1103.  LOCATE 25, center%                             ' locate center
  1104.  PRINT inst$;                                   ' print instruction
  1105.  
  1106. END SUB
  1107.  
  1108. SUB PrintMoves
  1109.  
  1110.  prog$ = "PrintMoves"                   ' print move count
  1111.  COLOR 15, 0
  1112.  MoveCounter% = MoveCounter% + 1        ' this is a little lumpy, but it rings
  1113.  LOCATE 12, 7
  1114.  PRINT "Moves:"
  1115.  LOCATE 14, 8
  1116.  PRINT MoveCounter%; SPACE$(4)
  1117.  
  1118. END SUB
  1119.  
  1120. SUB PrintPane (r%, c%)
  1121.  
  1122.  prog$ = "PrintPane"
  1123.  PaneColor% = m%(r%, c%)                        ' get pane color from board
  1124.  COLOR ColorVal%(PaneColor%)                    ' set color to print
  1125.   FOR p% = 1 TO 3
  1126.    PaneLineRow% = 3 + ((r% - 1) * 3 + p%)       ' find pane line row
  1127.    PaneCol% = 21 + (c% * 3 - 1)                 ' find pane line col
  1128.    LOCATE PaneLineRow%, PaneCol%                ' go there
  1129.    PRINT pane$(PaneColor%, p%);                 ' print pane segment
  1130.   NEXT p%
  1131.  IF PaneColor% > 0 THEN SOUND 37, .1            ' click if pane is not blank
  1132.  
  1133. END SUB
  1134.  
  1135. SUB PrintScore
  1136.  
  1137.  prog$ = "PrintScore"                   ' print remainder
  1138.  LOCATE 6, 5
  1139.  COLOR 15, 0
  1140.  PRINT "  Panes"
  1141.  LOCATE 7, 5
  1142.  PRINT "remaining:"
  1143.  LOCATE 9, 7
  1144.  PRINT remainder%; SPACE$(4)
  1145.  
  1146. END SUB
  1147.  
  1148. SUB Quit
  1149.  
  1150.  prog$ = "Quit"
  1151.  CALL NukeHelp
  1152.  CALL NukeCursor
  1153.  inst$ = "Are you sure you want to quit?  (y/n)"        ' load instruction
  1154.  InColor% = 15                                          ' set color
  1155.  CALL PrintInst(inst$, InColor%)                        ' print it
  1156. QuitLoop:                                    
  1157.  in$ = INKEY$
  1158.   IF in$ = "" THEN GOTO QuitLoop                        ' if no input, go back
  1159.   IF in$ = "N" OR in$ = "n" THEN GOTO ExitQuit          ' doesn't want to quit
  1160.   IF in$ = "Y" OR in$ = "y" THEN                        ' does want to quit
  1161.    CALL StartOver                                       ' ask for restart
  1162.    CALL ClearBoard                                      ' restarting - clear
  1163.    StartOverFlag% = 1                                   '   and start over
  1164.    GOTO ExitQuit
  1165.   END IF
  1166. GOTO QuitLoop
  1167.  
  1168. ExitQuit:
  1169.  CALL PrintHelp
  1170.  
  1171. END SUB
  1172.  
  1173. SUB RedrawBoard
  1174.  
  1175. prog$ = "RedrawBoard"
  1176.  FOR r% = 1 TO 6
  1177.   FOR c% = 1 TO 12
  1178.    CALL PrintPane(r%, c%)               ' redraw all panes
  1179.   NEXT c%
  1180.  NEXT r%
  1181.  
  1182. END SUB
  1183.  
  1184. SUB Rules
  1185.  
  1186.  prog$ = "Rules"
  1187.  MemFlag% = 1                           ' tell game not to remember demo moves
  1188.  OldBack% = BackupCount%                ' save backup count
  1189.  Oldremainder% = remainder%             ' save remainder
  1190.  OldMoves% = MoveCounter% - 1           ' save move count
  1191.  BackupCount% = 0                       ' set backup count to zero
  1192.  CALL PrintBackups                      ' print backup count
  1193.  CALL NukeHelp                          ' remove help menus
  1194.  FOR r% = 1 TO 6
  1195.   FOR c% = 1 TO 12
  1196.    t%(r%, c%) = m%(r%, c%)              ' save game
  1197.    m%(r%, c%) = 0                       ' zero game
  1198.   NEXT c%
  1199.  NEXT r%
  1200.  
  1201. ' I'm only going to comment out the first demo; the rest are identical
  1202.  
  1203. Demo1:
  1204.  GOSUB ZapBoard                         ' clear board
  1205.  FOR i% = 1 TO 6                        ' set two columns of panes
  1206.   m%(i%, 6) = i%
  1207.   m%(i%, 7) = i%
  1208.  NEXT i%
  1209.  CALL RedrawBoard                       ' draw them
  1210.  remainder% = 18                        ' set remainder
  1211.  CALL PrintScore                        ' print it
  1212.  MoveCounter% = -1                      ' set move counter
  1213.  CALL PrintMoves                        ' print it
  1214.  inst$ = "1: Any color may jump over itself to a blank space."
  1215.  InColor% = 15
  1216.  CALL PrintInst(inst$, InColor%)        ' print first example
  1217.  CALL WaitOne                           ' wait .5 seconds
  1218.  FOR i% = 1 TO 6
  1219.   OrgRow% = i%                          ' do six moves, all from col 6
  1220.   OrgCol% = 6                           '   to col 8
  1221.   DestRow% = i%                         '
  1222.   DestCol% = 8
  1223.   CALL CheckMove                        ' check each move
  1224.   CALL Move                             ' do each move
  1225.   CALL PrintMoves                       ' print each move
  1226.   CALL WaitOne                          ' wait .5 sec
  1227.  NEXT i%
  1228.  CALL WaitOne                           ' wait again
  1229.  GOSUB Again                            ' ask for repeat
  1230.   IF in$ = "Y" THEN GOTO Demo1          ' go back if yes
  1231.  
  1232. Demo2:
  1233.  inst$ = "2: Any color may jump over itself to itself."
  1234.  InColor% = 15
  1235.  CALL PrintInst(inst$, InColor%)
  1236.  GOSUB ZapBoard
  1237.  FOR i% = 1 TO 6
  1238.   m%(i%, 6) = i%
  1239.   m%(i%, 7) = i%
  1240.   m%(i%, 8) = i%
  1241.  NEXT i%
  1242.  CALL RedrawBoard
  1243.  remainder% = 27
  1244.  MoveCounter% = -1
  1245.  CALL PrintScore
  1246.  CALL PrintMoves
  1247.  CALL WaitOne
  1248.  FOR i% = 1 TO 6
  1249.   OrgRow% = i%
  1250.   OrgCol% = 8
  1251.   DestRow% = i%
  1252.   DestCol% = 6
  1253.   CALL CheckMove
  1254.   CALL Move
  1255.   CALL PrintMoves
  1256.   CALL WaitOne
  1257.  NEXT i%
  1258.  CALL WaitOne
  1259.  GOSUB Again
  1260.   IF in$ = "Y" THEN GOTO Demo2
  1261.  
  1262. Demo3:
  1263.  inst$ = "3: If a primary jumps over a secondary color, the primary is subtracted."
  1264.  CALL PrintInst(inst$, InColor%)
  1265.  GOSUB ZapBoard
  1266.  FOR i% = 1 TO 5
  1267.   m%(i%, 6) = i%
  1268.   m%(i%, 7) = i% + 1
  1269.  NEXT i%
  1270.  m%(6, 6) = 6
  1271.  m%(6, 7) = 1
  1272.  CALL RedrawBoard
  1273.  remainder% = 18
  1274.  MoveCounter% = -1
  1275.  CALL PrintScore
  1276.  CALL PrintMoves
  1277.  CALL WaitOne
  1278.  FOR i% = 1 TO 6 STEP 2
  1279.   OrgRow% = i%
  1280.   OrgCol% = 6
  1281.   DestRow% = i%
  1282.   DestCol% = 8
  1283.   CALL CheckMove
  1284.   CALL Move
  1285.   CALL PrintMoves
  1286.   CALL WaitOne
  1287.   CALL WaitOne
  1288.   OrgRow% = i% + 1
  1289.   OrgCol% = 7
  1290.   DestRow% = i% + 1
  1291.   DestCol% = 5
  1292.   CALL CheckMove
  1293.   CALL Move
  1294.   CALL PrintMoves
  1295.   CALL WaitOne
  1296.   CALL WaitOne
  1297.   NEXT i%
  1298.  CALL WaitOne
  1299.  GOSUB Again
  1300.   IF in$ = "Y" THEN GOTO Demo3
  1301.  
  1302. Demo4:
  1303.  GOSUB ZapBoard
  1304.  tb$ = "053131500153531003151530"
  1305.  char% = 0
  1306.  FOR r% = 1 TO 6
  1307.   FOR c% = 5 TO 8
  1308.    char% = char% + 1
  1309.    m%(r%, c%) = VAL(MID$(tb$, char%, 1))
  1310.   NEXT c%
  1311.  NEXT r%
  1312.  CALL RedrawBoard
  1313.  remainder% = 18
  1314.  MoveCounter% = -1
  1315.  CALL PrintScore
  1316.  CALL PrintMoves
  1317.  inst$ = "4: If a primary jumps to a different primary, the primaries combine."
  1318.  CALL PrintInst(inst$, InColor%)
  1319.  CALL WaitOne
  1320.  FOR i% = 1 TO 6 STEP 2
  1321.   OrgRow% = i%
  1322.   OrgCol% = 8
  1323.   DestRow% = i%
  1324.   DestCol% = 6
  1325.   CALL CheckMove
  1326.   CALL Move
  1327.   CALL PrintMoves
  1328.   CALL WaitOne
  1329.   CALL WaitOne
  1330.   OrgRow% = i% + 1
  1331.   OrgCol% = 5
  1332.   DestRow% = i% + 1
  1333.   DestCol% = 7
  1334.   CALL CheckMove
  1335.   CALL Move
  1336.   CALL PrintMoves
  1337.   CALL WaitOne
  1338.   CALL WaitOne
  1339.  NEXT i%
  1340.  CALL WaitOne
  1341.  GOSUB Again
  1342.   IF in$ = "Y" THEN GOTO Demo4
  1343.  
  1344. Demo5:
  1345.  GOSUB ZapBoard
  1346.  tb$ = "134512356"
  1347.  char% = 0
  1348.  FOR r% = 2 TO 4
  1349.   FOR c% = 5 TO 7
  1350.    char% = char% + 1
  1351.    m%(r%, c%) = VAL(MID$(tb$, char%, 1))
  1352.   NEXT c%
  1353.  NEXT r%
  1354.  CALL RedrawBoard
  1355.  remainder% = 12
  1356.  MoveCounter% = -1
  1357.  CALL PrintScore
  1358.  CALL PrintMoves
  1359.  inst$ = "5: If a primary jumps to a secondary, the result is a tertiary (white)."
  1360.  CALL PrintInst(inst$, InColor%)
  1361.  CALL WaitOne
  1362.  FOR i% = 2 TO 4
  1363.   OrgRow% = i%
  1364.   OrgCol% = 5
  1365.   DestRow% = i%
  1366.   DestCol% = 7
  1367.   CALL CheckMove
  1368.   CALL Move
  1369.   CALL PrintMoves
  1370.   CALL WaitOne
  1371.   CALL WaitOne
  1372.  NEXT i%
  1373.  CALL WaitOne
  1374.  GOSUB Again
  1375.   IF in$ = "Y" THEN GOTO Demo5
  1376.  
  1377. Demo6:
  1378.  GOSUB ZapBoard
  1379.  tb$ = "170370570"
  1380.  char% = 0
  1381.  FOR r% = 2 TO 4
  1382.   FOR c% = 5 TO 7
  1383.    char% = char% + 1
  1384.    m%(r%, c%) = VAL(MID$(tb$, char%, 1))
  1385.   NEXT c%
  1386.  NEXT r%
  1387.  CALL RedrawBoard
  1388.  remainder% = 12
  1389.  MoveCounter% = -1
  1390.  CALL PrintScore
  1391.  CALL PrintMoves
  1392.  inst$ = "6: If a primary jumps over a tertiary, the primary is subtracted."
  1393.  CALL PrintInst(inst$, InColor%)
  1394.  CALL WaitOne
  1395.  FOR i% = 2 TO 4
  1396.   OrgRow% = i%
  1397.   OrgCol% = 5
  1398.   DestRow% = i%
  1399.   DestCol% = 7
  1400.   CALL CheckMove
  1401.   CALL Move
  1402.   CALL PrintMoves
  1403.   CALL WaitOne
  1404.   CALL WaitOne
  1405.  NEXT i%
  1406.  CALL WaitOne
  1407.  GOSUB Again
  1408.   IF in$ = "Y" THEN GOTO Demo6
  1409.  
  1410. Demo7:
  1411.  GOSUB ZapBoard
  1412.  tb$ = "270470670"
  1413.  char% = 0
  1414.  FOR r% = 2 TO 4
  1415.   FOR c% = 5 TO 7
  1416.    char% = char% + 1
  1417.    m%(r%, c%) = VAL(MID$(tb$, char%, 1))
  1418.   NEXT c%
  1419.  NEXT r%
  1420.  CALL RedrawBoard
  1421.  remainder% = 15
  1422.  MoveCounter% = -1
  1423.  CALL PrintScore
  1424.  CALL PrintMoves
  1425.  inst$ = "7: If a secondary jumps over a tertiary, the secondary is subtracted."
  1426.  CALL PrintInst(inst$, InColor%)
  1427.  CALL WaitOne
  1428.  FOR i% = 2 TO 4
  1429.   OrgRow% = i%
  1430.   OrgCol% = 5
  1431.   DestRow% = i%
  1432.   DestCol% = 7
  1433.   CALL CheckMove
  1434.   CALL Move
  1435.   CALL PrintMoves
  1436.   CALL WaitOne
  1437.   CALL WaitOne
  1438.  NEXT i%
  1439.  CALL WaitOne
  1440.  GOSUB Again
  1441.   IF in$ = "Y" THEN GOTO Demo7
  1442. GOTO ExitRules
  1443.  
  1444. ' demos end here
  1445.  
  1446. Again:
  1447.  inst$ = "Do you need to see that again? (y/n/Esc)"
  1448.  CALL PrintInst(inst$, InColor%)                    ' print message
  1449. AgainLoop:                   
  1450.  in$ = UCASE$(INKEY$)
  1451.   IF in$ = CHR$(27) THEN GOTO ExitRules             ' if Esc, quit demos
  1452.   IF in$ <> "N" AND in$ <> "Y" THEN GOTO AgainLoop  ' if not y or n, try again
  1453. RETURN
  1454.  
  1455. ZapBoard:                       ' clear board
  1456.  CALL ClearBoard
  1457.   FOR r% = 1 TO 6
  1458.    FOR c% = 1 TO 12
  1459.     m%(r%, c%) = 0
  1460.    NEXT c%
  1461.   NEXT r%
  1462. RETURN
  1463.  
  1464. ExitRules:
  1465.  FOR r% = 1 TO 6
  1466.   FOR c% = 1 TO 12
  1467.    m%(r%, c%) = t%(r%, c%)       ' put board back
  1468.   NEXT c%
  1469.  NEXT r%
  1470.  CALL ClearBoard
  1471.  remainder% = Oldremainder%
  1472.  CALL PrintScore
  1473.  MoveCounter% = OldMoves%
  1474.  CALL PrintMoves
  1475.  CALL PrintHelp
  1476.  BackupCount% = OldBack%
  1477.  CALL PrintBackups
  1478.  MemFlag% = 0                    ' tell move routine to remember future moves
  1479.  
  1480. END SUB
  1481.  
  1482. SUB save
  1483.  
  1484.  prog$ = "Save"
  1485.  DIM t$(9)                                      ' dimension temp strings
  1486.  CALL NukeHelp                                  ' remove help screen
  1487.  
  1488. StartSave:
  1489.  inst$ = "Enter game save file name or press <Esc> to abort."   ' set msg
  1490.  InColor% = 15                                  ' set msg color
  1491.  CALL PrintInst(inst$, InColor%)                ' print msg
  1492.  InRow% = 24                                    ' set input row
  1493.  InCol% = 36                                    ' set input col
  1494.  InLen% = 8                                     ' set input length
  1495.  InDef$ = LastFileName$                         ' set input default to last
  1496.  CALL MagicInput(InRow%, InCol%, InLen%, InDef$, in$)  ' get input
  1497.  in$ = UCASE$(in$)                              ' set input to upper case
  1498.  IF in$ = "" THEN GOTO ExitSave                 ' if input is blank, abort
  1499.  LastFileName$ = in$                            ' set input default to input
  1500.  sv$ = in$ + ".SAV"                             ' append file extension
  1501.  OPEN sv$ FOR RANDOM AS #1 LEN = 13             ' open file
  1502.   FIELD #1, 13 AS out$                          ' field file
  1503.  GET #1, 1                                      ' get remainder
  1504.   v% = VAL(out$)
  1505.   IF v% > 0 THEN GOSUB BadSaveFile              ' if remainder exists, warn
  1506.  LSET out$ = STR$(remainder%)                   ' output remainder
  1507.  PUT #1, 1                                      '
  1508.  LSET out$ = STR$(MoveCounter%)                 ' output move counter
  1509.  PUT #1, 2                                      '
  1510.  LSET out$ = STR$(BackupCount%)                 ' output backup counter
  1511.  PUT #1, 3
  1512.  FOR r% = 1 TO 6                                '
  1513.   t$ = ""                                       '
  1514.    FOR c% = 1 TO 12                             '
  1515.     z$ = LTRIM$(RTRIM$(STR$(m%(r%, c%))))       '
  1516.     t$ = t$ + z$                                ' save picture of board
  1517.    NEXT c%                                      '
  1518.   LSET out$ = t$                                '
  1519.   PUT #1, r% + 3                                '
  1520.  NEXT r%                                        '
  1521.  FOR i% = 1 TO MoveCounter%                     ' save each move
  1522.   FOR j% = 0 TO 9                               ' save each game variable
  1523.    t$(j%) = LTRIM$(RTRIM$(STR$(game%(i%, j%)))) ' make into string
  1524.   NEXT j%
  1525.   IF LEN(t$(2)) < 2 THEN t$(2) = t$(2) + " "    ' pad if needed
  1526.   IF LEN(t$(5)) < 2 THEN t$(5) = t$(5) + " "    '
  1527.   IF LEN(t$(8)) < 2 THEN t$(8) = t$(8) + " "    '
  1528.   z$ = ""
  1529.   FOR j% = 0 TO 9                               ' concatenate into one string
  1530.    z$ = z$ + t$(j%)
  1531.   NEXT j%
  1532.   LSET out$ = z$
  1533.   PUT #1, i% + 9                                ' output it into file
  1534.  NEXT i%                                        ' next move
  1535.  CLOSE #1                                       ' close file
  1536. GOTO ExitSave
  1537.  
  1538. BadSaveFile:
  1539.  inst$ = sv$ + " already exists.  OK to overwrite it? (y/n)"    ' set msg
  1540.  InColor% = 15                                  ' set msg color
  1541.  CALL PrintInst(inst$, InColor%)                ' print msg
  1542. BadSaveLoop:                         
  1543.  in$ = UCASE$(INKEY$)                           ' get key
  1544.   IF in$ = "" THEN GOTO BadSaveLoop             ' if blank, get another
  1545.   IF in$ = "Y" THEN                             ' if yes, return
  1546.     RETURN
  1547.   END IF
  1548.   IF in$ <> "N" THEN GOTO BadSaveLoop           ' if not N, get key     
  1549.  CLOSE #1                                       ' close file
  1550. GOTO StartSave                                  ' go back to start
  1551.  
  1552. ExitSave:
  1553.  
  1554.  LOCATE 24, 35                                  ' clear input spot
  1555.  PRINT "          ";
  1556.  CALL PrintHelp                                 ' put help back
  1557.  
  1558. END SUB
  1559.  
  1560. SUB SetColor
  1561.  
  1562.  prog$ = "SetColor"
  1563.   ColorVal%(0) = 0              ' blank           
  1564.   ColorVal%(1) = 4              ' red
  1565.   ColorVal%(2) = 13             ' violet
  1566.   ColorVal%(3) = 9              ' blue
  1567.   ColorVal%(4) = 10             ' green
  1568.   ColorVal%(5) = 14             ' yellow
  1569.   ColorVal%(6) = 12             ' orange
  1570.   ColorVal%(7) = 15
  1571.   ColorFlag% = 1                ' set color
  1572.  
  1573. END SUB
  1574.  
  1575. SUB SetMono
  1576.  
  1577.  prog$ = "SetMono"
  1578.  FOR i = 1 TO 7
  1579.   ColorVal%(i) = 7              ' set all colors to gray
  1580.  NEXT i
  1581.  
  1582.  
  1583. END SUB
  1584.  
  1585. SUB StartOver
  1586.  
  1587.  prog$ = "StartOver"
  1588.  inst$ = "Would you like to start a new game? (y/n)"    ' set msg
  1589.  InColor% = 15                                  ' set input color
  1590.  CALL PrintInst(inst$, InColor%)                ' print msg
  1591. StartOverLoop:
  1592.  in$ = UCASE$(INKEY$)                           ' get key
  1593.   IF in$ = "" THEN GOTO StartOverLoop           ' if none, go back
  1594.   IF in$ = "N" THEN                             ' if no, end game with this long message:
  1595.    CLS
  1596.    PRINT "      Stained Glass is distributed using the classical shareware model.  As"
  1597.    PRINT "usual, you are encouraged to make and give away (not sell) as many copies of"
  1598.    PRINT "the game as you wish, provided that you include the files SG.BAS, SG.EXE,"
  1599.    PRINT "SG.DOC, and KENTBEST.SAV.  You are furthermore encouraged to use whatever"
  1600.    PRINT "archiving or compression program you like, as long as you include all of the"
  1601.    PRINT "files named above."
  1602.    PRINT "        If you like Stained Glass and would like to lend your support to"
  1603.    PRINT "high-quality, non-copy-protected, user-supported software (and documentation"
  1604.    PRINT "with way too many hyphens and parentheses per sentence) we ask that you send"
  1605.    PRINT "ten US dollars to:"
  1606.    PRINT
  1607.    PRINT "        Brewster and Brewster"
  1608.    PRINT "        2152 Santa Cruz Avenue"
  1609.    PRINT "        Santa Clara, CA  95051"
  1610.    PRINT
  1611.    PRINT "        Any questions?  Please feel free to call us at (408) 296-5529, after"
  1612.    PRINT "six o'clock p.m., Pacific time, or drop us a line via E-mail at CompuServe"
  1613.    PRINT "account number 76516,3034.  While the money is VERY important to us -- it lets"
  1614.    PRINT "us keep writing this stuff, after all -- we would love to hear from you whether"
  1615.    PRINT "you are a registered user or not."
  1616.    PRINT "        P. S.  Yes, that file SG.BAS is source code.  You will need QuickBASIC"
  1617.    PRINT "version 4 or higher to do anything with it.  Please note that you are getting"
  1618.    PRINT "it for FREE rather than having to send an additional hundred bucks, as is"
  1619.    PRINT "usually the case.";
  1620.    
  1621.    END                                          ' end program
  1622.   END IF
  1623.   IF in$ <> "Y" THEN GOTO StartOverLoop         ' if not y, goto start
  1624.  inst$ = ""                                     ' blank bottom line
  1625.  CALL PrintInst(inst$, InColor%)
  1626.  
  1627. END SUB
  1628.  
  1629. SUB TitlePage
  1630.  
  1631.  prog$ = "TitlePage"
  1632.  inst$ = "Press the space bar to step through demo or Esc to begin the game."
  1633.  InCol% = 15                                    ' set msg; set color
  1634.  CALL PrintInst(inst$, InCol%)                  ' print msg          
  1635.  
  1636. TitleLoop1:                           
  1637.  GOSUB SetupTitlePage
  1638.  IF stepflag% = 0 THEN
  1639.   CALL WaitOne                                  ' wait .5 secs
  1640.   CALL WaitOne
  1641.  ELSE
  1642.   CALL WaitForKey
  1643.  END IF
  1644.   IF ColorFlag% = 0 THEN GOSUB NukeLetters      ' nuke letters if monochrome
  1645.  FOR mov% = 1 TO 15
  1646.  GOSUB DoMove                                   ' do title page move
  1647.  in$ = INKEY$                                   ' get key
  1648.   IF in$ = CHR$(27) THEN GOTO ExitTitlePage     ' if esc, quit
  1649.   IF in$ = CHR$(32) THEN                        ' if space, do step
  1650.   stepflag% = 1
  1651.   END IF
  1652.   IF stepflag% = 0 THEN
  1653.    CALL WaitOne                                 ' wait .5 secs
  1654.   ELSE
  1655.    CALL WaitForKey                              ' wait for keypress
  1656.     IF in$ = CHR$(27) THEN GOTO ExitTitlePage
  1657.   END IF
  1658.  NEXT mov%
  1659. GOTO TitleLoop1
  1660.                                                 
  1661. DoMove:                                         ' actually make the move
  1662.  OrgRow% = TitleMove%(mov%, 1)                  ' get org row
  1663.  OrgCol% = TitleMove%(mov%, 2)                  ' get org col
  1664.  s$ = CHR$(SCREEN(3 + (OrgRow% * 3 - 1), 21 + (OrgCol% * 3)))  ' get org letter
  1665.  DestRow% = TitleMove%(mov%, 3)                 ' get dest row
  1666.  DestCol% = TitleMove%(mov%, 4)                 ' get dest col
  1667.  CALL CheckMove                                 ' check move
  1668.  j$ = CHR$(SCREEN(3 + (JumpRow% * 3 - 1), 21 + (JumpCol% * 3))) ' get dest letter
  1669.  CALL Move                                      ' do move
  1670.   IF ColorFlag% = 1 THEN                        ' print letter if color
  1671.    LOCATE 3 + (DestRow% * 3 - 1), 21 + (DestCol% * 3)
  1672.    COLOR 15, 0
  1673.    PRINT s$;
  1674.   END IF
  1675.   IF m%(JumpRow%, JumpCol%) > 0 AND ColorFlag% = 1 THEN
  1676.    LOCATE 3 + (JumpRow% * 3 - 1), 21 + (JumpCol% * 3)
  1677.    COLOR 15, 0                                  ' print letter if color
  1678.    PRINT j$;
  1679.   END IF
  1680. RETURN
  1681.                                                 
  1682. SetupTitlePage:                      
  1683.  remainder% = 17                                ' set remainder
  1684.  CALL PrintScore                                ' print score
  1685.  CALL PrintBackups                              ' print backups
  1686.  MoveCounter% = -1                              ' set move counter
  1687.  CALL PrintMoves                                ' print move counter
  1688.  r% = 3                                         ' start at row 3
  1689.  FOR i% = 1 TO 7                                ' print 'STAINED'
  1690.   c% = i% + 2                                   ' set col
  1691.   PaneColor% = i%                               ' set color
  1692.    IF PaneColor% > 6 THEN PaneColor% = PaneColor% - 6 ' don't go over color 6
  1693.   m%(r%, c%) = PaneColor%                       ' set pane
  1694.   CALL PrintPane(r%, c%)                        ' print pane
  1695.   LOCATE 3 + (r% * 3 - 1), 21 + (c% * 3)        ' locate center of pane
  1696.   COLOR 15, 0                                   ' set color to bright white
  1697.   PRINT MID$("STAINED", i%, 1);                 ' print letter
  1698.  NEXT i%
  1699.  r% = 4                                         ' go to row 4
  1700.  FOR i% = 2 TO 6
  1701.   c% = i% + 2                                   ' start at col 3
  1702.   PaneColor% = 7 - i%                           ' get pane color
  1703.   m%(r%, c%) = PaneColor%                       ' set pane
  1704.   CALL PrintPane(r%, c%)                        ' print pane
  1705.   LOCATE 3 + (r% * 3 - 1), 21 + (c% * 3)        ' print letter
  1706.   COLOR 15, 0                                   ' set color  
  1707.   PRINT MID$("GLASS", i% - 1, 1);               ' print letter
  1708.  NEXT i%
  1709. RETURN
  1710.                                                 
  1711. NukeLetters:                         
  1712.  CALL WaitOne                                   ' wait .5 sec
  1713.  CALL WaitOne
  1714.  CALL RedrawBoard                               ' redraw without letters
  1715. RETURN
  1716.                                                 
  1717. ExitTitlePage:                       
  1718.                                                 
  1719. CALL ClearBoard                                 ' clear board
  1720.  inst$ = ""                                     ' blank inst
  1721.  CALL PrintInst(inst$, InCol%)                  ' print inst
  1722.  COLOR 15, 0                                    ' set color
  1723.  LOCATE 12, 38
  1724.  PRINT "for";
  1725.  LOCATE 13, 36                                  ' print dedication
  1726.  PRINT "Annalisa.";
  1727.  CALL WaitOne                                   ' wait .5 secs
  1728.  
  1729. END SUB
  1730.  
  1731. SUB UntagSource
  1732.  
  1733.  prog$ = "UnTagSource"
  1734.  r% = OrgRow%                   ' set org row
  1735.  c% = OrgCol%                   ' set org col
  1736.  CALL PrintPane(r%, c%)         ' print pane
  1737.  
  1738. END SUB
  1739.  
  1740. SUB WaitForKey
  1741.  
  1742.  prog$ = "WaitForKey"
  1743.  
  1744. WaitLoop:
  1745.  in$ = INKEY$                           ' do nothing until key is pressed
  1746.  IF in$ = "" THEN GOTO WaitLoop         ' in$ = key
  1747.  
  1748. END SUB
  1749.  
  1750. SUB WaitOne
  1751.  
  1752.  prog$ = "WaitOne"
  1753.  
  1754. StartTime! = TIMER
  1755.  WHILE TIMER < StartTime! + .5          ' wait for .5 sec to pass
  1756.  WEND
  1757.  
  1758. END SUB
  1759.  
  1760. SUB Win
  1761.  
  1762.  prog$ = "Win"
  1763.  CALL NukeHelp                                  ' remove help
  1764.  inst$ = "Winner!  We've got a winner!!  Press any key to continue."    ' set msg
  1765.  InColor% = 15                                  ' set msg color
  1766.  CALL PrintInst(inst$, InColor%)                ' print msg
  1767.  CALL WaitForKey                                ' wait for key
  1768.  FOR r% = 1 TO 6
  1769.   FOR c% = 1 TO 12
  1770.    t%(r%, c%) = m%(r%, c%)                      ' save game to temp matrix
  1771.    m%(r%, c%) = r%                              ' set pane to r%
  1772.   NEXT c%
  1773.  NEXT r%
  1774.  inst$ = "Now, see if you can do it less than" + STR$(MoveCounter%) + " moves!"
  1775.  CALL PrintInst(inst$, InColor%)                ' print message
  1776.  
  1777. WinLoop:
  1778.  CALL RedrawBoard                               ' draw board (stripes)
  1779.  FOR r% = 1 TO 6                                ' do in each row
  1780.   FOR c% = 4 TO 9                               ' do from pane 4 to 9
  1781.    LOCATE 3 + (r% * 3 - 1), 21 + (c% * 3)       ' locate middle of each pane
  1782.    COLOR 15, 0                                  ' set color to bright white
  1783.    PRINT MID$("WINNER", c% - 3, 1);             ' print letter
  1784.   NEXT c%
  1785.  NEXT r%
  1786.   IF INKEY$ = "" THEN GOTO WinLoop              ' if no key, do it again
  1787.  FOR r% = 1 TO 6
  1788.   FOR c% = 1 TO 12
  1789.    m%(r%, c%) = t%(r%, c%)                      ' reset game matrix to temp
  1790.   NEXT c%
  1791.  NEXT r%
  1792.  CALL RedrawBoard                               ' draw it
  1793.  CALL save                                      ' save it?
  1794.  CALL PrintHelp                                 ' print help
  1795.  
  1796. END SUB
  1797.  
  1798.